/* Compressed with CompressRexx v3.0 (CMPMODE NORMAL), (C) 1993-96 Robert Hofmann */
options results;basefilename="DH0:organiser/";welcome_message="Welcome to fserv v1 By M.Rushton (Skeletor), Security Bug fixed by MrQue .... commands currently supported: CD, DIR, GET, MAKEDIR, LIST, LEAVE/QUIT, AVAIL";pattern="DH0:comms/irc/amirc/rexx/fservpattern";PARSE ARG onick bf;onick=strip(onick);IF onick='' THEN DO;'echo Usage: <nick> [root directory]';EXIT;END;IF bf~='' THEN basefilename=strip(bf);pragma('d',basefilename);basefilename=pragma('d');IF right(basefilename,1)~='/' & right(basefilename,1)~=':' THEN basefilename=basefilename'/';wfor='';'say /dcc chat 'onick;'say /msg 'onick' 'welcome_message;PRAGMA('d',basefilename);line='';StartTime = TIME(S) + 300;DO FOREVER;IF TIME(S) > StartTime THEN DO;nick=arg(1);'say /dcc close chat 'nick;wait 1;'say /msg 'nick' Bye bye! Max Idle time. Closing DCC Chat connection.';exit;END;ret='';GETMYNICK;mynick=result;lline=line;DO WHILE lline=line;GETLASTLINE;line=result;END;PARSELINE line;nick=line.prefix;to=line.dest;PARSE VAR nick nick '!'
call UPLOAD(line,nick,onick,pattern);PARSE VAR line ':' nick '!' ' ' type ' ' morejunk ' ' ':' txt;type=morejunk;PARSE UPPER VAR txt cmd rest;IF left(cmd,1)~=';' THEN DO;IF upper(nick)=upper(onick) & type='DCCMSG' THEN DO;StartTime = TIME(S) + 300;SELECT;WHEN cmd='CD' THEN CALL CD(nick,rest,basefilename);WHEN cmd='DIR' THEN CALL DIR(nick,rest);WHEN cmd='LIST' THEN CALL LIS(nick,rest);WHEN cmd='SEND' THEN CALL SEND(nick,rest);WHEN cmd='GET' THEN CALL GET(nick,rest,basefilename);WHEN cmd='MAKEDIR' | cmd='MKDIR' THEN CALL MAKDIR(nick,rest);WHEN cmd='LEAVE' | cmd='QUIT' THEN call le(nick);WHEN cmd='AVAIL' THEN call info(nick,basefilename);WHEN cmd='I' | cmd='IGNORE' THEN NOP;WHEN cmd='Y' | cmd='YES' THEN NOP;WHEN cmd='N' | cmd='NO' THEN NOP;OTHERWISE 'say /msg 'nick' Sorry... Command:'cmd' is unknown';END;END;END;END;EXIT;CD: PROCEDURE;nick=ARG(1);rest=strip(ARG(2));bfname=strip(ARG(3));SELECT;WHEN left(rest,6)='FSERV:' THEN direct=bfname||SUBSTR(rest,7,length(rest)-6);WHEN index(rest,':')~=0 THEN DO
direct=PRAGMA('D');'say /msg 'nick' Sorry... You must stay within the confines of FSERV: ';END;OTHERWISE direct=rest;END;IF right(bfname,1)='/' THEN bfname=left(bfname,length(bfname)-1);PRAGMA('d',direct);IF rest='/' & length(pragma('d'))<length(bfname) THEN DO;'say /msg 'nick' Sorry... You must stay within the confines of FSERV: ';direct=bfname;END;dirname=PRAGMA('D');r=right(bfname,1);IF r~=':' & r~='/' THEN bfnamee=bfname'/';ELSE bfnamee=bfname;PARSE VAR dirname (bfnamee) dirname;IF STRIP(dirname)='' THEN pragma('d',bfname);'say /msg 'nick' FSERV:'dirname;RETURN;DIR: PROCEDURE;nick=ARG(1);rest=strip(ARG(2));bold='02'x;SELECT;WHEN left(rest,6)='FSERV:' THEN NOP;WHEN index(rest,'/')~=0 | index(rest,':')~=0 THEN DO;rest='';'say /msg 'nick' Sorry... You must stay within the confines of FSERV: ';END;OTHERWISE NOP;END;IF POS('INTER',upper(rest))~=0 THEN rest='';'say /msg 'nick' 'bold||'Directory listing:'bold;address command 'dir 'rest' >pipe:dirlist';IF open(in,'pipe:dirlist') THEN DO;DO until eof(in)
line=readln(in);IF pos(' (dir)',line)~=0 THEN DO;PARSE VAR line dirname ',' pw '(dir)';IF strip(pw)~='' THEN line=bold||dirname' (dir) PASSWORD PROTECTED'||bold;ELSE line=bold||line||bold;END;'say /msg 'nick' 'line;END;END;CLOSE(in);RETURN;GET: PROCEDURE;nick=STRIP(ARG(1));rest=STRIP(ARG(2));bfname=STRIP(ARG(3));sendspace='YES';IF rest='' THEN 'say /msg 'nick' Usage: GET <filename>';IF rest~='' THEN DO;IF left(rest,6)='FSERV:' THEN DO;parse var rest 'FSERV:' rest;rest=strip(bfname)||strip(rest);END;IF left(rest,6)~='FSERV:' THEN DO;rest=PRAGMA('d')'/'rest;END;IF ~exists(rest) THEN 'say /msg 'nick' File not found....';IF exists(rest) THEN DO;IF index(rest,' ')~=0 & UPPER(sendspace)='YES' THEN DO;fname=compress(PARSEFILENAME(rest));address command 'copy "'rest'" t:'fname;rest='t:'fname;END;'say /dcc send 'nick' 'rest;'say /msg 'nick' Attempting to send file now...';END;END;RETURN;MAKDIR: PROCEDURE;nick=STRIP(ARG(1));rest=STRIP(ARG(2));bfname=STRIP(ARG(3));lrest=rest
IF rest='' THEN 'say /msg 'nick' Usage: MAKEDIR <directory name>[,password]';IF rest~='' THEN DO;IF left(rest,6)='FSERV:' THEN DO;parse var rest 'FSERV:' rest;rest=strip(bfname)||strip(rest);END;IF left(rest,6)~='FSERV:' THEN DO;rest=PRAGMA('d')'/'rest;END;IF right(rest,1)='/' THEN rest=left(rest,length(rest)-1);IF exists(rest) THEN 'say /msg 'nick' Sorry.... 'lrest' already exists. Makedir failed';IF ~exists(rest) THEN DO;IF ~MAKEDIR(rest) THEN 'say /msg 'nick' Makedir failed for an unknown reason' ELSE 'say /msg 'nick' Directory 'lrest' created';END;RETURN;LIS: PROCEDURE;nick=ARG(1);rest=strip(ARG(2));bold='02'x;SELECT;WHEN left(rest,6)='FSERV:' THEN NOP;WHEN index(rest,'/')~=0 | index(rest,':')~=0 THEN DO;rest='';'say /msg 'nick' Sorry... You must stay within the confines of FSERV: ';END;OTHERWISE NOP;END;IF POS('INTER',upper(rest))~=0 THEN rest='';'say /msg 'nick' Directory listing:';address command 'list 'rest' >pipe:dirlist';IF open(in,'pipe:dirlist') THEN DO;DO until eof(in);line=readln(in)
IF pos('Dir',line)~=0 THEN DO;PARSE VAR line dirname ',' pw 'Dir' junk date;IF strip(pw)~='' THEN line=bold||dirname' PW PROTECTED Dir 'date||bold;ELSE DO;PARSE VAR line dirname 'Dir' junk date;line=bold||dirname' Dir'date||bold;END;END;IF pos('Dir',line)=0 THEN DO;PARSE VAR line filename size junk date;line=filename' 'size||date;END;'say /msg 'nick' 'line;END;CLOSE(in);RETURN;info: PROCEDURE;nick=strip(arg(1));bfname=strip(arg(2));address command 'info >pipe:info 'bfname;open(in,'pipe:info','r');DO n=1 to 4;line=readln(in);END;PARSE VAR line unit size used free full '%' junk;PARSE VAR size size 'M';size=size*1024;block_size=size/(free+used);free=block_size*free;used=block_size*used;IF free>1024 THEN DO;free=trunc(free/1024,1);free=free'Mb';END;ELSE free=trunc(free)'Kb';IF used>1024 THEN DO;used=trunc(used/1024,1);used=used'Mb';END;ELSE used=trunc(used)'Kb';'say /msg 'nick' Used:'used' Free:'strip(free)' Full:'full'% Left:'100-full'%';CLOSE(in);RETURN;le: PROCEDURE;nick=arg(1)
'say /msg 'nick' Bye bye! Closing DCC Chat connection.';'say /dcc close chat 'nick;exit;END;ParseFileName: procedure;parse arg FilePath, Part;DivPos = max(lastpos(':', FilePath),lastpos('/', FilePath)) +1;if abbrev('FILE', upper(Part));then return substr(FilePath, DivPos);else;return strip(left(FilePath, DivPos-1),'T', '/');UPLOAD: PROCEDURE;line=arg(1);nick=arg(2);onick=arg(3);pattern=arg(4);wfor='';ex='';type='';resp='Y';PARSE VAR line ':' morejunk ':' dcc send name junk;IF length(dcc)=4 THEN dcc=right(dcc,(length(dcc)-1));IF dcc='DCC' & send='SEND' & upper(nick)=upper(onick) & wfor='' THEN DO;suffix=UPPER(RIGHT(NAME,(LENGTH(NAME))-(LASTPOS('.',NAME))));dest=pragma('d');IF suffix~='' & open(in,pattern) THEN DO;DO UNTIL eof(in) | ex~='';suffix_data=readln(in);PARSE VAR suffix_data suf type ldest;IF right(ldest,1)='/' & length(ldest)~=0 THEN ldest=left(ldest,length(ldest)-1);IF strip(upper(suf))=upper(suffix) THEN ex=-1;END;CLOSE(IN);IF ex=-1 THEN DO
IF upper(type)='ASK' THEN resp=askusr(nick,onick,suffix,ldest);IF upper(type)='FORCE' THEN dest=ldest;END;END;IF ex~=-1 THEN ldest=dest;IF resp='Y' then dest=ldest;dest=strip(dest,'l');finame=dest'/'name;IF resp~='I' THEN DO;'say /dcc get 'nick' 'name' 'finame;IF type='ASK' | type='' THEN 'say /msg 'nick' Now receiving 'name;IF type='FORCE' THEN 'say /msg 'nick' Now forcing 'name' to 'ldest' because it has suffix 'suf;END;IF resp='I' THEN 'say /msg 'nick' FSERV will ignore current DCC offer for 'PARSEFILENAME(name);END;RETURN;ASKUSR: PROCEDURE;nick=arg(1);onick=arg(2);suffix=arg(3);destination_path=arg(4);retval='';'say /msg 'nick' DCC send detected with suffix 'suffix'. Would you like me to move this to: 'destination_path'? (YES/NO/IGNORE)';DO until retval~='';lline=line;DO WHILE lline=line;GETLASTLINE;line=result;END;PARSELINE line;nick=line.prefix;to=line.dest;PARSE VAR nick nick '!';PARSE VAR line ':' nick '!' ' ' type ' ' morejunk ' ' ':' txt;type=morejunk;PARSE UPPER VAR txt cmd rest
IF left(cmd,1)~=';' THEN DO;IF upper(nick)=upper(onick) & type='DCCMSG' THEN DO;IF cmd='YES' | rest='Y' THEN retval='Y';IF cmd='NO' | rest='N' THEN retval='N';IF cmd='IGNORE' | rest='I' THEN retval='I';END;END;END;RETURN retval
/* Original script: 426 lines, 11188 bytes, cmprate 26.5% */
